home *** CD-ROM | disk | FTP | other *** search
/ Mac Magazin/MacEasy 2 / Mac Magazin and MacEasy Magazine CD - Issue 02.iso / Sharewarebibliothek / Applikationen / Alpha.5.81 folder / Tcl / UserCode / Text Filters / Strip Mail Headers < prev   
Text File  |  1994-03-08  |  772b  |  39 lines
  1. #!/usr/local/bin/perl
  2. #
  3. #  Keep only acceptable mail header fields
  4. #
  5.  
  6. @ok = split(/^/,<<END) ;
  7. From
  8. To
  9. Date
  10. Subject
  11. Cc
  12. END
  13.  
  14. $header = 0 ;
  15. foreach $key (@ok) { chop($key) ; $acceptable{$key} = 1 ; }
  16.  
  17. #foreach $key (@ok) {
  18. #    print STDOUT $key," :  ",$acceptable{$key},"\n" ; }
  19.  
  20. line: while (<>) {
  21.     study;
  22.     
  23.     if (/^(Received:|Path:|Message-Ii][Dd]:|X\w+:|BABYL OPTIONS:|\037)/) { $header = 1; next line ; }
  24. #    if (/^Path:/) { $header = 1; next line ; }
  25. #    if (/^Message-[Ii][Dd]:/) { $header = 1; next line ; }
  26.  
  27.     if ($header) {
  28.         if (/^\s*$/) { $header = 0 ; }
  29.         if (/^([-A-Za-z]+): /) { 
  30.             $keyword = $1 ; 
  31.         } else {
  32.             $keyword = "Received" ;
  33.         }
  34. #        print $keyword," :  ",$acceptable{$keyword},"\n" ;
  35.     }
  36.             
  37.     print STDOUT $_ unless ($header && ! $acceptable{$keyword}) ;
  38. }
  39.